home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / DBL Pascal Library / Fast-BV / Fast-bv.lap.lisp < prev    next >
Encoding:
Text File  |  1993-04-20  |  10.4 KB  |  256 lines  |  [TEXT/CCL2]
  1. ;;;; Assembly (LAP) code for Fast Bit Vectors unit.
  2. ;;;; D.B.Lamkins
  3.  
  4. ; procedure NextBit_Inline(table: Ptr; bvPtr: Ptr; var index: Integer);
  5. ;  A bit-vector (bv) is an integer bit count followed by the bits.
  6. ;  The bit indices start at 0 and increase left-to-right.
  7. ;  The table is indexed -8..255, mapping (index->value)
  8. ;    -8->$FF, -7->$7F, -6->$3F, -5->$1F, -4->$0F, -3->$07, -2->$03, -1->$01,
  9. ;    1->-1, 2..3->-2, 4..7->-3, 8..15->-4, 16..31->-5, 32..63->-6,
  10. ;    64..127->-7, and 128..255->-8.
  11. ;  NextBit_Inline expects the address of table[0].
  12. ;  NextBit_Inline returns the index of the next set bit.
  13. ;  When there are no more set bits, the returned index is -1.
  14. (hex-lap-list
  15.  (movem.l #(a2 d3) -@sp)                ; save registers we'll clobber
  16.  (move.l sp@+ a1)                       ; reference to the index parameter
  17.  (move.w @a1 d0)                        ; the starting index
  18.  (move.l sp@+ a0)                       ; pointer to the bit-vector
  19.  (move.l sp@+ a2)                       ; pointer to the lookup table
  20.  (move.l a1 -@sp)                       ; save the index reference
  21.  (move.w a0@+ d2)                       ; get bv length
  22.                                         ; also advance to bit data
  23.  (move.l a0 a1)                         ; remember where the bits begin
  24.  (add.w ($ 1) d0)                       ; advance index past last found bit
  25.  (cmp.w d2 d0)                          ; test for finished
  26.  (bge @2)                               ; no bits left - bail out
  27.  (move.w d0 d3)                         ; remember the new starting index
  28.  (lsr.w 3 d0)                           ; compute byte offset
  29.  (ext.l d0)
  30.  (add.l d0 a0)                          ; set starting position
  31.  (add.w ($ 7) d2)                       ; set up loop count
  32.  (lsr.w 3 d2)
  33.  (sub.w d0 d2)
  34.  (sub.w ($ 1) d2)
  35.  (clr.w d1)
  36.  (move.b a0@+ d1)                       ; get first byte
  37.  (and.w ($ 7) d3)                       ; mask according to starting offset
  38.  (and.b (a2 d3.w -8) d1)
  39.  (bra @1.5)
  40.  @1
  41.  (move.b a0@+ d1)                       ; fetch next byte from vector
  42.  @1.5
  43.  (dbne d2 @1)                           ; repeat until non-zero
  44.  (beq @2)                               ; bail out if we reached the end
  45.  (move.b (a2 d1.w) d1)                  ; lookup set bit's position offset
  46.  (ext.w d1)                             ; (need sign extension for later)
  47.  (sub.l a1 a0)                          ; compute byte offset of found bit
  48.  (move.w a0 d0)                         ; (+1, fixed by position lookup)
  49.  (lsl.w 3 d0)                           ; multiply by 8 bits per byte
  50.  (add.w d0 d1)                          ; add the position of the set bit
  51.  (bra @3)
  52.  @2
  53.  (move.w ($ -1) d1)                     ; set up return for "no more bits"
  54.  @3
  55.  (move.l sp@+ a1)                       ; recall the index reference
  56.  (move.w d1 @a1)                        ; return what we found
  57.  (movem.l sp@+ #(a2 d3))                ; restore clobbered registers
  58.  )
  59.  
  60. ; procedure BlockFill_Inline(value: SignedByte; block: Ptr; length: Integer);
  61. (hex-lap-list
  62.  (move.w sp@+ d1)                       ; length
  63.  (sub.w ($ 1) d1)                       ; adjust for DBcc
  64.  (move.l sp@+ a0)                       ; block address
  65.  (move.w sp@+ d0)                       ; fill value
  66.  @1
  67.  (move.b d0 a0@+)                       ; fill each byte
  68.  (dbf d1 @1)
  69.  )
  70.  
  71. ; procedure BlockAND_Inline (src1, src2, dst: Ptr; length: Integer);
  72. (hex-lap-list
  73.  (move.l a2 -@sp)                       ; can't clobber this
  74.  (move.w sp@+ d1)                       ; length
  75.  (sub.w ($ 1) d1)                       ; adjust for DBcc
  76.  (move.l sp@+ a2)                       ; dst block address
  77.  (move.l sp@+ a1)                       ; src2 block address
  78.  (move.l sp@+ a0)                       ; src1 block address
  79.  @1
  80.  (move.b a0@+ d0)                       ; loop over srcs, result to dst
  81.  (and.b a1@+ d0)
  82.  (move.b d0 a2@+)
  83.  (dbf d1 @1)
  84.  (move.l sp@+ a2)                       ; restore clobbered reg
  85.  )
  86.  
  87. ; procedure BlockOR_Inline (src1, src2, dst: Ptr; length: Integer);
  88. (hex-lap-list
  89.  (move.l a2 -@sp)                       ; can't clobber this
  90.  (move.w sp@+ d1)                       ; length
  91.  (sub.w ($ 1) d1)                       ; adjust for DBcc
  92.  (move.l sp@+ a2)                       ; dst block address
  93.  (move.l sp@+ a1)                       ; src2 block address
  94.  (move.l sp@+ a0)                       ; src1 block address
  95.  @1
  96.  (move.b a0@+ d0)                       ; loop over srcs, result to dst
  97.  (or.b a1@+ d0)
  98.  (move.b d0 a2@+)
  99.  (dbf d1 @1)
  100.  (move.l sp@+ a2)                       ; restore clobbered reg
  101.  )
  102.  
  103. ; procedure BlockEOR_Inline (src1, src2, dst: Ptr; length: Integer);
  104. (hex-lap-list
  105.  (move.l a2 -@sp)                       ; can't clobber this
  106.  (move.w sp@+ d1)                       ; length
  107.  (sub.w ($ 1) d1)                       ; adjust for DBcc
  108.  (move.l sp@+ a2)                       ; dst block address
  109.  (move.l sp@+ a1)                       ; src2 block address
  110.  (move.l sp@+ a0)                       ; src1 block address
  111.  @1
  112.  (move.b a0@+ d0)                       ; loop over srcs, result to dst
  113.  (move.b a1@+ d1)
  114.  (eor.b d1 d0)
  115.  (move.b d0 a2@+)
  116.  (dbf d1 @1)
  117.  (move.l sp@+ a2)                       ; restore clobbered reg
  118.  )
  119.  
  120. ; procedure BlockNOT_Inline (src, dst: Ptr; length: Integer);
  121. (hex-lap-list
  122.  (move.w sp@+ d1)                       ; length
  123.  (sub.w ($ 1) d1)                       ; adjust for DBcc
  124.  (move.l sp@+ a1)                       ; dst block address
  125.  (move.l sp@+ a0)                       ; src block address
  126.  @1
  127.  (move.b a0@+ d0)                       ; loop over src, result to dst
  128.  (not.b d0)
  129.  (move.b d0 a1@+)
  130.  (dbf d1 @1)
  131.  )
  132.  
  133. ; function BlockEqual_Inline (bv1, bv2: Ptr; length: Integer): Boolean;
  134. (hex-lap-list
  135.  (move.w sp@+ d1)                       ; length
  136.  (sub.w ($ 1) d1)                       ; adjust for DBcc
  137.  (move.l sp@+ a1)                       ; bv2 block address
  138.  (move.l sp@+ a0)                       ; bv1 block address
  139.  @1
  140.  (cmp.b a0@+ a1@+)                      ; loop over blocks, leave on mismatch
  141.  (dbne d1 @1)
  142.  (seq.b (sp 1))                         ; return true if equal
  143.  (neg.b (sp 1))
  144.  )
  145.  
  146. ; function BlockAllClear_Inline (bv: Ptr; length: Integer):Boolean;
  147. (hex-lap-list
  148.  (move.w sp@+ d1)                       ; length
  149.  (sub.w ($ 1) d1)                       ; adjust for DBcc
  150.  (move.l sp@+ a0)                       ; bv block address
  151.  @1
  152.  (tst.b a0@+)                           ; loop over block, leave on nonzero
  153.  (dbne d1 @1)
  154.  (seq.b (sp 1))                         ; return true if all zero
  155.  (neg.b (sp 1))
  156.  )
  157.  
  158. ; function BlockAllSet_Inline (bv: Ptr; length: Integer): Boolean;
  159. (hex-lap-list
  160.  (move.w sp@+ d1)                       ; length
  161.  (sub.w ($ 1) d1)                       ; adjust for DBcc
  162.  (move.l sp@+ a0)                       ; bv block address
  163.  @1
  164.  (tst.b a0@+)                           ; loop over block, leave on zero
  165.  (dbeq d1 @1)
  166.  (sne.b (sp 1))                         ; return true if all ones
  167.  (neg.b (sp 1))
  168.  )
  169.  
  170. ; procedure BlockANDCmpl_Inline (src1, src2, dst: Ptr; length: Integer);
  171. (hex-lap-list
  172.  (move.l a2 -@sp)                       ; can't clobber this
  173.  (move.w sp@+ d1)                       ; length
  174.  (sub.w ($ 1) d1)                       ; adjust for DBcc
  175.  (move.l sp@+ a2)                       ; dst block address
  176.  (move.l sp@+ a1)                       ; src2 block address
  177.  (move.l sp@+ a0)                       ; src1 block address
  178.  @1
  179.  (move.b a1@+ d0)                       ; loop over srcs, result to dst
  180.  (not.b d0)
  181.  (and.b a0@+ d0)
  182.  (move.b d0 a2@+)
  183.  (dbf d1 @1)
  184.  (move.l sp@+ a2)                       ; restore clobbered reg
  185.  )
  186.  
  187. ; procedure BlockORCmpl_Inline (src1, src2, dst: Ptr; length: Integer);
  188. (hex-lap-list
  189.  (move.l a2 -@sp)                       ; can't clobber this
  190.  (move.w sp@+ d1)                       ; length
  191.  (sub.w ($ 1) d1)                       ; adjust for DBcc
  192.  (move.l sp@+ a2)                       ; dst block address
  193.  (move.l sp@+ a1)                       ; src2 block address
  194.  (move.l sp@+ a0)                       ; src1 block address
  195.  @1
  196.  (move.b a1@+ d0)                       ; loop over srcs, result to dst
  197.  (not.b d0)
  198.  (or.b a0@+ d0)
  199.  (move.b d0 a2@+)
  200.  (dbf d1 @1)
  201.  (move.l sp@+ a2)                       ; restore clobbered reg
  202.  )
  203.  
  204. ; procedure BlockEORCmpl_Inline (src1, src2, dst: Ptr; length: Integer);
  205. (hex-lap-list
  206.  (move.l a2 -@sp)                       ; can't clobber this
  207.  (move.w sp@+ d1)                       ; length
  208.  (sub.w ($ 1) d1)                       ; adjust for DBcc
  209.  (move.l sp@+ a2)                       ; dst block address
  210.  (move.l sp@+ a1)                       ; src2 block address
  211.  (move.l sp@+ a0)                       ; src1 block address
  212.  @1
  213.  (move.b a1@+ d1)                       ; loop over srcs, result to dst
  214.  (not.b d1)
  215.  (move.b a0@+ d0)
  216.  (eor.b d1 d0)
  217.  (move.b d0 a2@+)
  218.  (dbf d1 @1)
  219.  (move.l sp@+ a2)                       ; restore clobbered reg
  220.  )
  221.  
  222. ; function BlockUnequal_Inline (bv1, bv2: Ptr; length: Integer): Boolean;
  223. (hex-lap-list
  224.  (move.w sp@+ d1)                       ; length
  225.  (sub.w ($ 1) d1)                       ; adjust for DBcc
  226.  (move.l sp@+ a1)                       ; bv2 block address
  227.  (move.l sp@+ a0)                       ; bv1 block address
  228.  @1
  229.  (cmp.b a0@+ a1@+)                      ; loop over blocks, leave on match
  230.  (dbeq d1 @1)
  231.  (sne.b (sp 1))                         ; return true if unequal
  232.  (neg.b (sp 1))
  233.  )
  234.  
  235. ; procedure BlockShiftBitsLeft_Inline(src, dst: Ptr; shift, length: Integer);
  236. (hex-lap-list
  237.  (movem.l #(d3 d4) -@sp)                ; save regs that we can't clobber
  238.  (move.w sp@+ d4)                       ; get length
  239.  (sub.w ($ 1) d4)                       ; adjust for loop count
  240.  (move.w sp@+ d2)                       ; get shift count (1..7)
  241.  (move.w d2 d3)                         ; compute complementary shift count
  242.  (neg.w d3)
  243.  (add.w ($ 8) d3)
  244.  (move.l sp@+ a1)                       ; get destination block ptr
  245.  (move.l sp@+ a0)                       ; get source block ptr
  246.  @1                                     ; loop over blocks while shifting
  247.  (clr.w d0)
  248.  (move.b a0@+ d0)                       ; load 'left' byte
  249.  (lsl.b d2 d0)                          ; shift left by count
  250.  (move.b @a0 d1)                        ; load 'right' byte
  251.  (lsr.b d3 d1)                          ; shift right by 8-count
  252.  (or.b d1 d0)                           ; merge left and right bytes, shifted
  253.  (move.b d0 a1@+)                       ; stuff into the result block
  254.  (dbf d4 @1)                            ; repeat until finished
  255.  (movem.l sp@+ #(d3 d4))                ; restore clobbered regs
  256.  )